perm filename SYMFUN.RLS[206,JMC] blob
sn#005326 filedate 1971-01-15 generic text, type T, neo UTF8
00100 OFF ECHO;
00200
00300 COMMENT MUL(U,V) GIVES THE PRODUCT OF THE SYMMETRIC MONOMIALS U
00400 AND V. U AND V ARE REPRESENTED AS DESCENDING LISTS OF EXPONENTS.
00500 THUS, (3 2 1) REPRESENTS SIGMA(X1↑3*X2↑2*X3). THE RESULT IS
00600 GIVEN AS A LIST OF TERMS EACH OF WHICH IS A LIST CONSISTING
00700 OF A COEFFICIENT AND SYMMETRIC MONOMIAL IN THE ABOVE NOTATION. THUS
00800 MUL('(1),'(1)) = ((1 (2)) (2 (1 1))) WHICH REPRESENTS THE FACT THAT
00900 (X+Y+Z)*(X+Y+Z) = (X↑2+Y↑2+Z↑2) + 2*(XY+YZ+ZX). ALL THE FUNCTIONS UP
01000 TO MUL ARE ITS SATELLITES.;
01100
01200 FOO(U,V,P,L) ← IF NULL V THEN APPEND(P,U) . L
01300 ELSE FOO(U,CDR V,CAR V.P,FOO1(U,U,CAR V,
01400 CDR V,P,L));
01500
01600 FOO1(U,U1,X,V,P,L) ← IF NULL U1 THEN L ELSE
01700 FOO(DEL(U1,U),V,(CAR U1 + X).P,
01800 FOO1(U,CDR U1,X,V,P,L));
01900
02000 DEL(U1,U) ← IF U1 EQ U THEN CDR U ELSE
02100 CAR U . DEL(U1,CDR U);
02200
02300 ORDERB U ← IF NULL U THEN NIL ELSE MERGE(CAR U,ORDERB CDR U);
02400
02500 MERGE(X,U) ← IF NULL U THEN LIST X ELSE IF X > CAR U THEN
02600 X.U ELSE CAR U . MERGE(X,CDR U);
02700
02800 COEFFA U ← IF NULL U THEN 1 ELSE COEFFB(1,CAR U,CDR U);
02900
03000 COEFFB(N,X,U) ← IF NULL U THEN 1
03100 ELSE IF X = CAR U THEN (N+1)*COEFFB(N+1,X,CDR U)
03200 ELSE COEFFB(1,CAR U,CDR U);
03300
03400 ORDERA U ← IF NULL U THEN NIL ELSE MERGEA(CADAR U,
03500 ORDERA CDR U);
03600
03700 MERGEA(X,U) ← IF NULL U THEN LIST(LIST(1,X))
03800 ELSE IF GRR(X,CADAR U) THEN LIST(1,X).U
03900 ELSE IF X=CADAR U THEN LIST(CAAR U + 1,X) . CDR U
04000 ELSE CAR U . MERGEA(X,CDR U);
04100
04200 GRR(U,V) ← NOT NULL U AND ((CAR U > CAR V)
04300 OR (CAR U = CAR V AND GRR
04400 (CDR U,CDR V)));
04500
04600 MUL(U,V)← (LAMBDA(M); MAPCAR(ORDERA(MAPCAR(
04700 FOO(U,V,NIL,NIL),FUNCTION(LAMBDA(W);
04800 LIST(1,ORDERB W)))),FUNCTION(LAMBDA(Z);
04900 LIST(QUOTIENT(CAR Z * COEFFA CADR Z,M),CADR Z))))
05000 (COEFFA U * COEFFA V);
05100
05200 ZAPB(W,M) ← IF CAR W = M THEN NIL ELSE
05300 (CAR W - M) . ZAPB(CDR W,M);
05400
05500 ZAPA(W) ← (LAMBDA (L,M); IF L=0 THEN NIL
05600 ELSE LIST(M,SIG(L)) . ZAPA(ZAPB(W,M)))
05700 (LENGTH W,CAR LAST W);
05800
05900 SIG(N) ← LIST('SIGMA,N);
06000
06100 ZAP V ← LIST(CAR V,ZAPA CADR V);
06200